home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
program
/
passmsrc.arc
/
PASSM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-02-04
|
47KB
|
1,375 lines
{***************************************************************************}
{* This program is a general purpose PAL assembler. You may copy and use *}
{* it for personal purposes. No commercial use of this program is allowed *}
{* without the consent of the author. *}
{* THIS IS THE Atari ST Version *}
{* (c) Copyright 1987,1988 by Erasmo Brenes. *}
{***************************************************************************}
program passm (input,output,source,simfile);
const
linewidth = 40;
blank = ' '; semicol = ';'; comment = '"';
maxterms = 19; maxinputs = 22;
maxpins = 24; npals = 23;
maxcols = 44; maxouts = 10;
type
symbol =( ident, int, num, eql, quotes, semicolon, apostrophe,
leftbrkt, rightbrkt, device, pin, equations,module,flag,
lftparen,rgtparen,title,node,stype,macro,andoperator,
oroperator,invert,colon,ends,enable,preset,clear);
palsymb = ( p10l8,p12l6,p14l4,p16l2,p16l8,p16rx,p12l10,p14l8,p16l6,
p18l4,p20l2,p20l10,p20l8,p20rx,p22vx);
tkens = packed array [1..15] of char;
kind = (reg, nonreg, bidir, tristate);
palsize = (input18, input22);
logic = (high, low);
trans1typ =
record
transfer : array[1..maxpins] of integer
end;
outtype =
record
outnumb : integer;
outname : tkens;
outkind : kind;
size : palsize;
form : logic;
matrix : array [1..maxterms,1..maxcols] of char
end;
entrytype =
record
name : tkens;
pinn : integer
end;
string2 = packed array [1..4] of char;
filnam = packed array [1..80] of char;
ptermtyp = array [1..maxcols] of char;
var
source,simfile : text;
token : tkens;
palknds : array [1..npals] of char;
pals : array [1..npals] of tkens;
symtable: array [1..maxpins] of entrytype;
outtable: array [1..11] of outtype;
palkind : palsymb;
fusetoinp,fusetopin : array [palsymb] of trans1typ;
paltyp : array [1..npals] of palsymb;
filspc : string[80];
sym : symbol;
reserved : array [1..13] of tkens;
pdevice : tkens;
wsym : array [1..13] of symbol;
ptype,ch,tab : char;
nexout,outindex : integer;
nexin : integer;
value,i,j,pointer,iterm,totalterms : integer;
Abort,empty,pal16,found : boolean;
ar, sp : ptermtyp;
procedure bgetchar (var ch:char);
begin
empty := false;
if eof(source)
then begin
empty := true;
ch := blank
end
else begin
if eoln(source)
then begin
readln (source);
ch := blank
end
else
if eof(source)
then begin
empty := true;
ch := blank
end
else begin
read (source,ch);
if ch = comment
then begin
repeat
readln (source);
if eof(source)
then begin
empty := true; ch := blank
end
else read (source,ch)
until (ch <> comment) or (eof(source))
end
end
end
end; {bgetchar}
procedure numbr;
{this routine always leaves with ch containing the next character!}
var
j : integer;
begin
sym := int;
value := 0; j:= 0;
repeat
value := 10*value + (ord(ch) - ord('0'));
bgetchar (ch); j:= j + 1
until not(ch in ['0'..'9'])
end; {numbr}
procedure gettoken;
var
i,j,k : integer;
begin
i:= 0;
while ((ch=blank)or(ch=tab))and(not empty) do bgetchar(ch);
if (ch in ['A'..'Z'])or(ch in['a'..'z'])or(ch = '-')
then begin
repeat
i:= i + 1;
token [i]:= ch; bgetchar(ch)
until not((ch in ['A'..'Z'])or(ch in['a'..'z'])or(ch in ['0'..'9'])
or (ch='_')) or empty or (i = 15);
if not empty
then begin
if (i < 15) then repeat
i:= i + 1; token[i]:= blank
until (i=15);
k := 0;
for j:=1 to 13 do
if token = reserved[j]
then k := j;
if k = 0
then sym := ident
else sym := wsym [k]
end
end
else begin
if (ch in ['0'..'9'])
then numbr
else case ch of
'^': begin
sym := num;
bgetchar (ch)
end;
'=': begin
sym := eql;
bgetchar (ch)
end;
';': begin
sym := semicolon;
bgetchar (ch)
end;
'''': begin
sym := apostrophe;
bgetchar (ch)
end;
'`': begin
sym := apostrophe;
bgetchar (ch)
end;
'"': begin
sym := quotes;
bgetchar (ch)
end;
'[': begin
sym := leftbrkt;
bgetchar (ch)
end;
']': begin
sym := rightbrkt;
bgetchar (ch)
end;
'(': begin
sym := lftparen;
bgetchar (ch)
end;
')': begin
sym := rgtparen;
bgetchar (ch)
end;
'!': begin
sym := invert;
bgetchar (ch)
end;
'&': begin
sym := andoperator;
bgetchar (ch)
end;
'#': begin
sym := oroperator;
bgetchar (ch)
end;
':': begin
sym := colon;
bgetchar (ch)
end;
otherwise:
begin
bgetchar (ch);
gettoken { get next token }
end
end
end
end; {gettoken}
procedure semimodule;
begin
gettoken;
while sym = semicolon
do gettoken;
end;
procedure search ( kind : integer);
var
i,j : integer;
begin
case kind of
1: begin
pointer := 0;
for i:=1 to npals do
if token = pals[i]
then pointer := i
end;
2: begin
j := pointer;
pointer := 0;
for i:=1 to 24 do
with symtable[i] do
if pinn = j
then pointer := i
end;
3: begin { search a signal name for its corresponding pin }
pointer := 0; found := false;
for i:= 1 to maxpins do
with symtable[i] do
if token = name
then begin
pointer := pinn; found := true
end
end;
otherwise:
writeln ('!!! software error in search procedure')
end
end; {search}
procedure start;
var
first : integer;
begin
while not(sym = equations) and (not Abort) and not(eof(source))do
begin
first := nexin + 1;
if sym = ident
then begin
nexin := nexin + 1;
symtable[nexin].name := token;
gettoken;
while sym = ident do
begin { get list of identifiers }
nexin := nexin + 1;
symtable[nexin].name := token;
gettoken
